home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0150_Data Dictionary using a BTree.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  5.8 KB  |  209 lines
  1. program Dict;
  2. (* simple dictionary using a btree.
  3.   The program reads in an ASCII file with one word per line and stores the
  4.   words in an btree. A btree is something like binary tree but every node
  5.   can have more than two descent nodes. This is done by linked list.
  6.  
  7.   This method has two advantages:
  8.     * when a word is wrong you can easily give some proposes how the word
  9.       is written correctly (just change the path in the tree a little)
  10.     * bigger dict. may save space. E.g "base, basicly, basement" etc.
  11.       share the same path on the first three niveaus.
  12.  
  13.   ATTENTION! I don't free any mem I've allocated. This is done by the
  14.   heap manager (i.e. he allocates large blockes and releases them } when
  15.   the program ends. But this can be added easily.
  16.  
  17.   Also, there is no function included that deletes words (I don't need it in
  18.   my project). I suggest it is not that easy to add such a function but
  19.   have a try ;-))
  20.  
  21. *)
  22.  
  23. { $DEFINE DEBUG} { if DEBUG is defined (just erase space between "{" and "$")
  24.                    then some actions are logged while building the tree and
  25.                    while searching. }
  26.  
  27. const debugfile = 'dict.log';     { log file (if needed) }
  28.       dictFileName = 'dict.dat';  { data input (words in ASCII) }
  29.  
  30. type  PNode     = ^TNode;
  31.       TNode     = record
  32.                     Character : Char;    { the current character }
  33.                     WordEnd   : Boolean; { is this char. the last of one word?}
  34.                     right,down: PNode;   { right: points to next char on the
  35.                                                   same niveau
  36.                                            down : points to the next char in
  37.                                                   word }
  38. {$IFDEF DEBUG}
  39.                     Level     : byte;    { level of the tree }
  40. {$ENDIF }
  41.                   end;
  42.  
  43. var BTree: PNode;                       { our tree }
  44.     DictFile: Text;                     { our ascii dictionary }
  45. {$IFDEF DEBUG}
  46. var f: Text;                            { log file handle }
  47. {$ENDIF }
  48.  
  49.  
  50. procedure CreateBTree;
  51. { just initalizes the tree w/ a dummy element }
  52. begin
  53.   Btree:=NIL;
  54.   New(Btree);
  55.   BTree^.character:=#$1A; { #$1A is END-OF-FILE. shouldn't be used in any word }
  56.   BTree^.right:=NIL;
  57.   Btree^.down:=NIL;
  58.   BTree^.Wordend:=true;
  59. {$IFDEF DEBUG}
  60.   BTree^.level:=1;
  61.   writeln(f,'B-Tree with dummy element created.');
  62. {$ENDIF }
  63. end;
  64.  
  65. {$IFDEF DEBUG}
  66. function GetNode(Character: Char; LevelPtr: PNode; Level: byte): PNode;
  67. {$ELSE }
  68. function GetNode(Character: Char; LevelPtr: PNode): PNode;
  69. {$ENDIF }
  70. { returns the node in Level "LevelPtr" that contains "Character".
  71.   if there is no node, it is created }
  72. var p: PNode;
  73. begin
  74.   if levelptr=NIL then begin
  75.     New(P);
  76.     P^.right:=NIL;
  77.     P^.down:=NIL;
  78.     P^.character:=character;
  79.     P^.WordEnd:=False;
  80. {$IFDEF DEBUG}
  81.     P^.Level:=Level;
  82.     writeln(f,'#New niveau-node enterd. Content of the first node: '+
  83.             ' "',character,'". Level ',level);
  84. {$ENDIF }
  85.     GetNode:=p;
  86.   end else begin
  87.     p:=levelptr;
  88.     while (p^.right<>NIL) and (p^.character<>Character) do p:=p^.right;
  89.     if p^.character=character then
  90.     begin
  91.       getnode:=p;
  92. {$IFDEF DEBUG}
  93.       writeln(f,'Node "',character,'" found on level ',level,'.');
  94. {$ENDIF }
  95.     end
  96.       else begin
  97.         { p^.right is NIL! }
  98.         new(p^.right);
  99.         p:=p^.right;
  100.         p^.character:=character;
  101.         p^.right:=NIL;
  102.         p^.down:=nil;
  103.         p^.wordend:=false;
  104. {$IFDEF DEBUG}
  105.         p^.level:=level;
  106.         writeln(f,'#Entered new node. Content "',character,'". Level ',level);
  107. {$ENDIF }
  108.         GetNode:=p;
  109.       end; {if}
  110.   end; { if }
  111. end;
  112.  
  113. procedure InsertWord(wort: string);
  114. { inserts the word "wort" into btree }
  115. var p1,p2,p3: PNode;
  116.     i: byte;
  117. begin
  118.   if wort='' then exit;
  119.   p2:=btree;
  120.   for i:=1 to length(wort) do
  121.   begin
  122. {$IFDEF DEBUG}
  123.     p1:=getnode(wort[i],p2,i);
  124. {$ELSE}
  125.     p1:=getnode(wort[i],p2);
  126. {$ENDIF}
  127.     if p2=NIL then p3^.down:=p1;
  128.     p3:=p1;
  129.     p2:=p1^.down;
  130.   end;
  131.   p1^.wordend:=true;
  132. {$IFDEF DEBUG}
  133.   writeln(f,'Wort "',wort,'" eingetragen.');
  134. {$ENDIF }
  135. end;
  136.  
  137. function ProofWord(Wort: string): boolean;
  138. { returns true if "wort" is in our dictionary }
  139. var P1,p2: PNode;
  140.     I: Byte;
  141. begin
  142.   ProofWord:=FALSE;
  143.   if wort='' then exit;
  144.   p1:=BTree;
  145.   i:=1;
  146. {$IFDEF DEBUG}
  147.   writeln(f,'Searching for word "',wort,'".');
  148. {$ENDIF }
  149.   while (p1<>NIL) and (length(wort)>=i) do begin
  150.     while (p1^.right<>NIL) and (p1^.character<>wort[i]) do p1:=p1^.right;
  151.     if p1^.character=wort[i] then begin
  152.       inc(i);
  153.       p2:=p1;
  154.       p1:=p1^.down;
  155. {$IFDEF DEBUG}
  156.       writeln(f,'Character "',wort[i-1],'" found on level ',i-1,'.');
  157. {$ENDIF }
  158.     end else p1:=NIL;
  159.   end;
  160.   if (i=length(wort)+1) and (p2^.wordend) then proofword:=TRUE;
  161. end;
  162.  
  163.  
  164. var OldExitProcPtr: Pointer;
  165.  
  166. procedure MyExitProc;far;
  167. begin
  168.   ExitProc:=OldExitProcPtr;
  169.   if exitcode = 214 then writeln('Huston! We''ve got a pointer problem!');
  170. {$IFDEF DEBUG}
  171.   close(f);
  172. {$ENDIF }
  173. end;
  174.  
  175. var s: String;
  176.  
  177. begin
  178.   OldExitProcPtr:=ExitProc;
  179.   ExitProc:=@MyExitProc;
  180.   {$IFDEF DEBUG}
  181.   assign(f,debugfile);
  182.   rewrite(f);
  183.   {$ENDIF }
  184.   assign(dictfile,dictfilename);
  185.   createBTree;
  186.   reset(dictfile);
  187.   write('Reading dictionary...');
  188.   while not eof(dictfile) do
  189.   begin
  190.     readln(dictfile,s);
  191.     insertword(s);
  192.   end;
  193.   writeln('done.');
  194.   writeln('Request mode. End with "END"!');
  195.   s:='';
  196.   repeat
  197.     write('OK>');
  198.     readln(s);
  199.     if s<>'END' then
  200.       if proofword(s) then writeln('Word found!',#7)
  201.                       else writeln('Word not fond!');
  202.  
  203.   until s='END';
  204.   {$IFDEF DEBUG}
  205.   close(f);
  206.   {$ENDIF }
  207.   ExitProc:=OldExitProcPtr;
  208. end.=====================Code ends===============================
  209.